﻿
Imports System.Runtime.CompilerServices
Imports System.IO
Imports System.Net
Imports osi.root.constants
Imports osi.root.procedure
Imports osi.root.utils
Imports osi.root.connector
Imports osi.root.lock
Imports osi.root.formation
Imports osi.root.delegates
Imports osi.root.envs
Imports osi.root.threadpool
Imports osi.service.convertor
Imports osi.service.http.constants.interval_ms

Public Module _server
    <Extension()> Public Sub shutdown(ByVal ctx As HttpListenerContext, Optional ByVal abort As Boolean = False)
        Try
            If Not ctx Is Nothing Then
                ctx.Request().InputStream().Close()
                ctx.Request().InputStream().Dispose()
                ctx.Response().OutputStream().Close()
                ctx.Response().OutputStream().Dispose()
            End If
        Catch ex As Exception
            raise_error(error_type.warning,
                        "failed to close related streams of HttpListenerContext, ex ",
                        ex.Message())
        End Try

        Try
            If Not ctx Is Nothing Then
                If abort Then
                    ctx.Response().Abort()
                Else
                    ctx.Response().Close()
                End If
            End If
        Catch ex As Exception
            raise_error(error_type.warning,
                        "failed to close HttpListenerContext, ex ",
                        ex.Message())
        End Try
    End Sub

    <Extension()> Public Function read_request_body_as_string(ByVal ctx As HttpListenerContext,
                                                              ByVal result As pointer(Of String),
                                                              Optional ByVal ls As link_status = Nothing) As event_comb
        Dim ec As event_comb = Nothing
        Dim ms As MemoryStream = Nothing
        Return New event_comb(Function() As Boolean
                                  ms = New MemoryStream()
                                  ec = read_request_body(ctx, ms, ls)
                                  Return waitfor(ec) AndAlso
                                         goto_next()
                              End Function,
                              Function() As Boolean
                                  If ec.end_result() Then
                                      assert(Not ctx Is Nothing)
                                      Dim e As Text.Encoding = Nothing
                                      If Not parse_encoding(ctx.Request().ContentType(), e) Then
                                          e = default_encoding
                                      End If
                                      assert(ms.Seek(0, SeekOrigin.Begin) = 0)
                                      Using reader As TextReader = New StreamReader(ms, e, False)
                                          Return eva(result, reader.ReadToEnd()) AndAlso
                                                 goto_end()
                                      End Using
                                  Else
                                      Return False
                                  End If
                              End Function)
    End Function

    <Extension()> Public Function read_request_body(ByVal ctx As HttpListenerContext,
                                                    ByVal result As Stream,
                                                    Optional ByVal ls As link_status = Nothing) As event_comb
        Dim ec As event_comb = Nothing
        Dim r As pointer(Of Int64) = Nothing
        Dim exp_len As Int64 = 0
        Return New event_comb(Function() As Boolean
                                  'do not support rfc1867
                                  If ctx Is Nothing OrElse
                                     Not ctx.Request().HasEntityBody() Then
                                      Return False
                                  Else
                                      If ls Is Nothing Then
                                          ls = link_status.server
                                      End If
                                      exp_len = ctx.Request().ContentLength64()
                                      If exp_len = 0 Then
                                          Return False
                                      ElseIf ls.over_max_content_length(exp_len) Then
                                          Return False
                                      Else
                                          r = New pointer(Of Int64)()
                                          ec = ctx.Request().InputStream().copy_to(result,
                                                                                   exp_len,
                                                                                   ls.buff_size,
                                                                                   ls.single_copy_timeout_ms,
                                                                                   r)
                                          Return waitfor(ec, ls.copy_timeout_ms) AndAlso
                                                 goto_next()
                                      End If
                                  End If
                              End Function,
                              Function() As Boolean
                                  Return ec.end_result() AndAlso
                                         (exp_len < 0 OrElse exp_len = (+r)) AndAlso
                                         goto_end()
                              End Function)
    End Function
End Module

Public Class server
    Public Event handle_context(ByVal ctx As HttpListenerContext, ByRef ec As event_comb)

    Private Const default_max_connection_count As Int32 = 1024
    Private Const default_response_timeout_ms As Int64 = 60 * minute_second * second_milli

    Private ReadOnly max_connection_count As Int32
    Private ReadOnly response_timeout_ms As Int64

    Private ReadOnly listener As HttpListener
    Private ReadOnly cc As atomic_int

    Shared Sub New()
        assert(HttpListener.IsSupported())
        ServicePointManager.DefaultConnectionLimit() = max_int32
        ServicePointManager.UseNagleAlgorithm() = False
    End Sub

    Public Sub New(ByVal max_connection_count As Int32,
                   ByVal response_timeout_ms As Int64)
        assert(max_connection_count > 0)
        assert(response_timeout_ms > 0)
        Me.max_connection_count = max_connection_count
        Me.response_timeout_ms = response_timeout_ms
        cc = New atomic_int()
        listener = New HttpListener()
        listener.IgnoreWriteExceptions() = True
    End Sub

    Public Sub New(ByVal max_connection_count As Int32)
        Me.New(max_connection_count, default_response_timeout_ms)
    End Sub

    Public Sub New(ByVal response_timeout_ms As Int64)
        Me.New(default_max_connection_count, response_timeout_ms)
    End Sub

    Public Sub New()
        Me.New(default_max_connection_count, default_response_timeout_ms)
    End Sub

    Public Sub New(ByVal max_connection_count As String,
                   ByVal response_timeout_ms As String)
        Me.New(max_connection_count.to_int32(default_max_connection_count),
               response_timeout_ms.to_int64(default_response_timeout_ms))
    End Sub

    Public Function connection_count() As Int32
        Return +cc
    End Function

    Public Function add_prefix(ByVal prefix As String) As Boolean
        Try
            listener.Prefixes().Add(prefix)
            Return True
        Catch ex As Exception
            raise_error(error_type.exclamation,
                        "failed to add prefix ", prefix, " to HttpListener, ex ", ex.Message)
            Return False
        End Try
    End Function

    Public Function add_port(ByVal port As UInt16) As Boolean
        Return add_prefix(constants.protocol_address_head.http +
                          character.plus_sign +
                          constants.uri.port_mark +
                          Convert.ToString(port) +
                          constants.uri.path_separator)
    End Function

    Public Function add_port(ByVal port As String) As Boolean
        Return add_port(port.to_uint16())
    End Function

    'block this hack solution first, to try if the issue by using async io of network stream has been fixed already.
    'a helper function to response in sync mode,
    'since the HttpListenerResponse has some unknown bugs to avoid the callback happen
    Private Shared Function write_response(ByVal ctx As HttpListenerContext, ByVal content() As Byte) As event_comb
        Return New event_comb(Function() As Boolean
                                  Return waitfor(
                                      Sub()
                                          If Not ctx Is Nothing AndAlso Not isemptyarray(content) AndAlso
                                             ctx.Response().OutputStream().CanWrite() Then
                                              ctx.Response().OutputStream().write(content, 0, array_size(content))
                                          End If
                                      End Sub) AndAlso
                                         goto_end()
                              End Function)
    End Function

    Private Sub start_context(ByVal ctx As HttpListenerContext)
        Dim ec As event_comb = Nothing
        assert_begin(New event_comb(Function() As Boolean
                                        RaiseEvent handle_context(ctx, ec)
                                        Return waitfor(ec, response_timeout_ms) AndAlso
                                               goto_next()
                                    End Function,
                                    Function() As Boolean
                                        ctx.shutdown(Not ec.end_result())
                                        Return assert(cc.decrement() >= 0) AndAlso
                                               goto_end()
                                    End Function))
    End Sub

    Private Sub listen()
        For i As Int32 = 0 To min(resolve_ithreadpool().thread_count(), Environment.ProcessorCount()) - 1
            Dim ctx As pointer(Of HttpListenerContext) = Nothing
            Dim ec As event_comb = Nothing
            assert_begin(New event_comb(Function() As Boolean
                                            If listener.IsListening() Then
                                                ec = Nothing
                                                If Not ctx Is Nothing Then
                                                    ctx.clear()
                                                End If
                                                If cc.increment() <= max_connection_count Then
                                                    If ctx Is Nothing Then
                                                        ctx = New pointer(Of HttpListenerContext)()
                                                    End If
                                                    ec = listener.get_context(ctx)
                                                    Return waitfor(ec) AndAlso
                                                           goto_next()
                                                Else
                                                    Return waitfor(over_max_connection_count_wait_time) AndAlso
                                                           goto_next()
                                                End If
                                            Else
                                                Return goto_end()
                                            End If
                                        End Function,
                                        Function() As Boolean
                                            If Not ec Is Nothing AndAlso
                                               ec.end_result() AndAlso
                                               Not +ctx Is Nothing Then
                                                start_context(+ctx)
                                            Else
                                                assert(cc.decrement() >= 0)
                                            End If
                                            Return goto_prev()
                                        End Function))
        Next
    End Sub

    Public Function start() As Boolean
        If listener.IsListening() Then
            Return False
        Else
            Try
                listener.Start()
            Catch ex As Exception
                raise_error(error_type.exclamation, "cannot start HttpListener, ex ", ex.Message())
                Return False
            End Try
            listen()
            Return True
        End If
    End Function

    Public Sub [stop](Optional ByVal wait_connections_ms As UInt32 = 0)
        If listener.IsListening() Then
            listener.Stop()
            listener.Prefixes().Clear()
            timeslice_sleep_wait_until(Function() connection_count() = 0, wait_connections_ms)
        End If
    End Sub

    Protected Overrides Sub Finalize()
        listener.Close()
        GC.KeepAlive(listener)
        MyBase.Finalize()
    End Sub
End Class
